home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d15
/
maximo_1.arc
/
TXT.ARC
/
MASTER.TXT
< prev
next >
Wrap
Text File
|
1991-08-20
|
6KB
|
324 lines
;
; MASTER -- MAIN PSDI PROGRAM
; (c) Copyright 1990 Chris Butler
;
video m
set esc "CTRL-Q"
set space off
set i 1
goto mstr_init
;reenter: ; don't blank scr w/VIDEO on reentry
entry_1:
set i 1
goto mstr_init
entry_2:
set i 2
goto mstr_init
entry_3:
set i 3
goto mstr_init
entry_4:
set i 4
goto mstr_init
entry_5:
set i 5
goto mstr_init
entry_6:
set i 6
goto mstr_init
entry_7:
set i 7
goto mstr_init
entry_8:
set i 8
goto mstr_init
entry_9:
set i 9
goto mstr_init
entry_10:
set i 10
goto mstr_init
entry_11:
set i 11
goto mstr_init
entry_12:
set i 12
goto mstr_init
entry_13:
set i 13
goto mstr_init
entry_14:
set i 14
goto mstr_init
entry_15:
set i 15
goto mstr_init
;CLOSEGL
mstr_init:
global keycolor 8
global numbboxes 17
init_box_list ; initialize menu data
setrgb 0 0,0,0 1
setrgb 6 21,42,42 1
setrgb 7 42,42,42 1
setrgb 8 52,52,52 1
setrgb 9 0,0,63 1
setrgb 15 63,63,63 1
pload menu9.pic 1
pfade 9 1 300
pfree 1
palette 1
toploop:
set y2 @("box."$@i$".y2")
color 0
box @("box."$@i$".x1")-2 @("box."$@i$".y1")-3 @("box."$@i$".x2")+3 @y2+2
color 8
box @("box."$@i$".x1")-3 @("box."$@i$".y1")-4 @("box."$@i$".x2")+4 @y2+3
waitkey 20 nogot
goto gotchar
nogot:
color 9
box @("box."$@i$".x1")-2 @("box."$@i$".y1")-3 @("box."$@i$".x2")+3 @y2+2
box @("box."$@i$".x1")-3 @("box."$@i$".y1")-4 @("box."$@i$".x2")+4 @y2+3
waitkey 20 toploop
goto gotchar
gotchar:
color 0 ; black box outline
box @("box."$@i$".x1")-2 @("box."$@i$".y1")-3 @("box."$@i$".x2")+3 @y2+2
color 8
box @("box."$@i$".x1")-3 @("box."$@i$".y1")-4 @("box."$@i$".x2")+4 @y2+3
ifkey ENTER do_proc UP do_up DOWN do_down
noise 600 300 50
goto toploop
do_down:
if @i==@numbboxes
set i 1
else
set i @i+1
endif
goto toploop
do_up:
if @i==1
set i @numbboxes
else
set i @i-1
endif
goto toploop
do_proc:
global h 5+@("box."$@i$".y2")-@("box."$@i$".y1")
global w 5+@("box."$@i$".x2")-@("box."$@i$".x1")
pushbutton @("box."$@i$".x1")-2 @("box."$@i$".y1")-3 @h @w @keycolor
goto @("jmptbl."$@i)
NOISE 1000 500 100 ; shouldn't get here
EXIT
;
; MAKEMENU -- setup menu screen
;
makemenu:
color 8
clearscr
set i 1
mark @numbboxes
set y2 @("box."$@i$".y2")
color @keycolor
rect @("box."$@i$".x1") @("box."$@i$".y1") @("box."$@i$".x2") @y2
color 0
box @("box."$@i$".x1")-2 @("box."$@i$".y1")-3 @("box."$@i$".x2")+3 @y2+2
set i @i+1
loop
return; subr MAKEMENU
;
; INITBOXLIST -- setup menu button data list
;
init_box_list:
databegin menudata
local i 1
mark @numbboxes
global "box."$@i$".x1" @
global "box."$@i$".y1" @
global "box."$@i$".x2" @
global "box."$@i$".y2" @
global "jmptbl."$@i @
set i @i+1
loop
return ; (init_box_list)
menudata:
304 431 624 447 shebang
304 406 624 422 ovrvu
304 381 624 397 ibmbp
304 356 624 372 supp
304 331 624 347 ww
304 306 624 322 clients
304 281 624 297 engr
304 256 624 272 sched
304 231 624 247 inv
304 206 624 222 accntg
304 181 624 197 mis
304 156 624 172 mgr
304 131 624 147 tstdrv
304 106 624 122 roi
304 81 624 97 about
304 56 624 72 help
304 31 624 47 dos
dataend
shebang:
link overview.txt all
ovrvu:
link overview.txt
ibmbp:
link ibmbp.txt
supp:
link support.txt
ww:
link ww.txt
clients:
link clients.txt
engr:
link engr.txt
sched:
link sched.txt
inv:
link inv.txt
accntg:
link purch.txt
mis:
link mis.txt
mgr:
link mgr.txt
tstdrv:
link udrive.txt
roi:
link roi.txt
about:
gosub about_subr
goto toploop
help:
gosub help_subr
goto toploop
dos:
exit
; HELP_SUBR -- main menu help
help_subr:
cgetbuf 1 24,27 272,471 1 0
cload helpclip.clp 2 1 0
cfade 20 24,27 2 100
waitkey
cfade 20 24,27 1
cfree 1 2
return ; HELP_SUBR
; ABOUT_SUBR -- intrctv mkg bit
about_subr:
cgetbuf 1 24,26 272,224 1 0
cload about.clp 2 1 0
cfade 20 24,26 2 100
waitkey
cfade 20 24,26 1
cfree 1 2
return ; ABOUT_SUBR
;
; COLORBARS -- diagnostic routine
;
colorbars:
set i "0"
offset 50,350
mark 16
color @i
rect 0,0 20,20
color 0
text 5,5 @i
offset 20,0 r
set i @i+1
loop
offset 0,0 ; COLORBARS code
return ; subr COLORBARS
;
; PUSHBUTTON -- actuate onscreen "button"
; uses MS Windows button format (white #15 top line and
; 2 bars of gray #8 shading)
;
pushbutton:
local llx @1 ; lower left corner of button x
local lly @2 ; lower left corner y
local h @3 ; height
local w @4 ; width
local keycolor @5 ; color of keytop
; note: uses buffer 1
local bndryoff (@llx+2)%8 ; boundary offset (@llx+2=x start of clipping)
set wait "0" ; diagnostic switch
cgetbuf 1 @llx+2,@lly+3 @llx+@w-3,@lly+@h-2 0 0; grab center of button [shifted]
color @keycolor
if @wait
waitkey
endif
line @llx+1,@lly+1 @llx+1,@lly+@h-1 ; gray out left white line
line @llx+1,@lly+@h-1 @llx+@w-1,@lly+@h-1 ; gray out top white line
putup 1+@bndryoff,-1 1
color @keycolor
point @llx+2,@lly+2
point @llx+@w-2,@lly+@h-2
if @wait
waitkey
endif
putup 2+@bndryoff,-2 1
point @llx+2,@lly+1
point @llx+3,@lly+1
point @llx+@w-1,@lly+@h-2
point @llx+@w-1,@lly+@h-3
color 8
line @llx+1,@lly+@h-1 @llx+@w-1,@lly+@h-1
color 0
line @llx+1,@lly+1 @llx+1,@lly+@h-1
if @wait
waitkey
endif
putup 1+@bndryoff,-1 1
color 7
line @llx+2,@lly+1 @llx+@w-1,@lly+1
line @llx+@w-1,@lly+1 @llx+@w-1,@lly+@h-2
color @keycolor
line @llx+1,@lly+@h-1 @llx+@w-1,@lly+@h-1
line @llx+1,@lly+1 @llx+1,@lly+@h-1
if @wait
waitkey
endif
cgetbuf 1 @llx+3,@lly+1 @llx+@w-1,@lly+@h-3 0 0 ;
putup @bndryoff,1 1 ; new clipping from lr corner
color 15
line @llx+1,@lly+1 @llx+1,@lly+@h-1
line @llx+1,@lly+@h-1 @llx+@w-1,@lly+@h-1
color 7
point @llx+1,@lly+1 ; ll corner
point @llx+@w-1,@lly+@h-1 ; tr corner
if @wait
waitkey
endif
return ; subr PUSHBUTTON